home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / ada / gnat1792.zip / gnat179b / t-adainc / a-stwibo.adb < prev    next >
Text File  |  1994-05-19  |  42KB  |  1,264 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT RUNTIME COMPONENTS                          --
  4. --                                                                          --
  5. --             A D A . S T R I N G S . W I D E _ B O U N D E D              --
  6. --                                                                          --
  7. --                                 S p e c                                  --
  8. --                                                                          --
  9. --                            $Revision: 1.5 $                              --
  10. --                                                                          --
  11. --           Copyright (c) 1992,1993,1994 NYU, All Rights Reserved          --
  12. --                                                                          --
  13. -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14. -- terms of the  GNU General Public License as published  by the Free Soft- --
  15. -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16. -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17. -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18. -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19. -- for  more details.  You should have  received  a copy of the GNU General --
  20. -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21. -- to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. --
  22. --                                                                          --
  23. ------------------------------------------------------------------------------
  24.  
  25.  
  26. with Ada.Strings.Wide_Search;
  27.  
  28. package body Ada.Strings.Wide_Bounded is
  29.  
  30.    package body Generic_Bounded_Length is
  31.  
  32.       ---------
  33.       -- "=" --
  34.       ---------
  35.  
  36.       function "=" (Left, Right : in Bounded_Wide_String) return Boolean is
  37.       begin
  38.          return Left.Length = Right.Length
  39.            and then Left.Data (1 .. Left.Length) =
  40.                     Right.Data (1 .. Right.Length);
  41.       end "=";
  42.  
  43.       ---------
  44.       -- "<" --
  45.       ---------
  46.  
  47.       function "<"  (Left, Right : in Bounded_Wide_String) return Boolean is
  48.       begin
  49.          return Left.Data (1 .. Left.Length) < Right.Data (1 .. Right.Length);
  50.       end "<";
  51.  
  52.       ----------
  53.       -- "<=" --
  54.       ----------
  55.  
  56.       function "<=" (Left, Right : in Bounded_Wide_String) return Boolean is
  57.       begin
  58.          return Left.Data (1 .. Left.Length) <= Right.Data (1 .. Right.Length);
  59.       end "<=";
  60.  
  61.       ---------
  62.       -- ">" --
  63.       ---------
  64.  
  65.       function ">"  (Left, Right : in Bounded_Wide_String) return Boolean is
  66.       begin
  67.          return Left.Data (1 .. Left.Length) > Right.Data (1 .. Right.Length);
  68.       end ">";
  69.  
  70.       ----------
  71.       -- ">=" --
  72.       ----------
  73.  
  74.       function ">=" (Left, Right : in Bounded_Wide_String) return Boolean is
  75.       begin
  76.          return Left.Data (1 .. Left.Length) >= Right.Data (1 .. Right.Length);
  77.       end ">=";
  78.  
  79.       ---------
  80.       -- "*" --
  81.       ---------
  82.  
  83.       function "*" (Left : in Natural; Right : in Wide_Character)
  84.          return Bounded_Wide_String is
  85.       begin
  86.          return Replicate (Left, Right, Strings.Error);
  87.       end "*";
  88.  
  89.       function "*" (Left  : in Natural; Right : in Wide_String)
  90.          return Bounded_Wide_String is
  91.       begin
  92.          return Replicate (Left, Right, Strings.Error);
  93.       end "*";
  94.  
  95.       function "*" (Left : in Natural; Right : in Bounded_Wide_String)
  96.          return Bounded_Wide_String is
  97.       begin
  98.          return Replicate (Left, Right, Strings.Error);
  99.       end "*";
  100.  
  101.       ---------
  102.       -- "&" --
  103.       ---------
  104.  
  105.       function "&" (Left, Right : in Bounded_Wide_String)
  106.          return Bounded_Wide_String is
  107.       begin
  108.          return Append (Left, Right, Drop => Strings.Error);
  109.       end "&";
  110.  
  111.       function "&" (Left : in Bounded_Wide_String; Right : in Wide_String)
  112.          return Bounded_Wide_String is
  113.       begin
  114.          return Append (Left, Right, Drop => Strings.Error);
  115.       end "&";
  116.  
  117.       function "&" (Left : in Wide_String; Right : in Bounded_Wide_String)
  118.          return Bounded_Wide_String is
  119.       begin
  120.          return Append (Left, Right, Drop => Strings.Error);
  121.       end "&";
  122.  
  123.       function "&" (Left : in Bounded_Wide_String; Right : in Wide_Character)
  124.          return Bounded_Wide_String is
  125.       begin
  126.          return Append (Left, Right, Drop => Strings.Error);
  127.       end "&";
  128.  
  129.       function "&" (Left : in Wide_Character; Right : in Bounded_Wide_String)
  130.          return Bounded_Wide_String is
  131.       begin
  132.          return Append (Left, Right, Drop => Strings.Error);
  133.       end "&";
  134.  
  135.       ------------
  136.       -- Append --
  137.       ------------
  138.  
  139.       --  Case of Bounded_Wide_String and Bounded_Wide_String
  140.  
  141.       function Append (Left, Right : in Bounded_Wide_String;
  142.                        Drop        : in Strings.Truncation :=
  143.                                           Strings.Error)
  144.         return Bounded_Wide_String
  145.       is
  146.          Result : Bounded_Wide_String;
  147.          Llen   : constant Positive := Left.Length;
  148.          Rlen   : constant Positive := Right.Length;
  149.  
  150.       begin
  151.          if Llen + Rlen <= Max_Length then
  152.             Result.Length := Llen + Rlen;
  153.             Result.Data (1 .. Llen) := Left.Data;
  154.             Result.Data (Llen + 1 .. Llen + Rlen) := Right.Data;
  155.  
  156.          else
  157.             Result.Length := Max_Length;
  158.  
  159.             case Drop is
  160.                when Strings.Right =>
  161.                   if Llen >= Max_Length then
  162.                      Result.Data (1 .. Max_Length) :=
  163.                        Left.Data (1 .. Max_Length);
  164.  
  165.                   else
  166.                      Result.Data (1 .. Llen) := Left.Data;
  167.                      Result.Data (Llen + 1 .. Max_Length) :=
  168.                        Right.Data (1 .. Max_Length - Llen);
  169.                   end if;
  170.  
  171.                when Strings.Left =>
  172.                   if Rlen >= Max_Length then
  173.                      Result.Data (1 .. Max_Length) :=
  174.                        Right.Data (Rlen - (Max_Length - 1) .. Rlen);
  175.  
  176.                   else
  177.                      Result.Data (1 .. Max_Length - Rlen) :=
  178.                        Left.Data (Llen - (Max_Length - Rlen + 1) .. Llen);
  179.                      Result.Data (Max_Length - Rlen + 1 .. Max_Length) :=
  180.                        Right.Data;
  181.                   end if;
  182.  
  183.                when Strings.Error =>
  184.                   raise Strings.Length_Error;
  185.             end case;
  186.          end if;
  187.  
  188.          return Result;
  189.       end Append;
  190.  
  191.       --  Case of Bounded_Wide_String and Wide_String
  192.  
  193.       function Append (Left  : in Bounded_Wide_String;
  194.                        Right : in Wide_String;
  195.                        Drop  : in Strings.Truncation := Strings.Error)
  196.         return Bounded_Wide_String
  197.       is
  198.          Result : Bounded_Wide_String;
  199.          Llen   : constant Positive := Left.Length;
  200.          Rlen   : constant Positive := Right'Length;
  201.  
  202.       begin
  203.          if Llen + Rlen <= Max_Length then
  204.             Result.Length := Llen + Rlen;
  205.             Result.Data (1 .. Llen) := Left.Data;
  206.             Result.Data (Llen + 1 .. Llen + Rlen) := Right;
  207.  
  208.          else
  209.             Result.Length := Max_Length;
  210.  
  211.             case Drop is
  212.                when Strings.Right =>
  213.                   if Llen >= Max_Length then
  214.                      Result.Data (1 .. Max_Length) :=
  215.                        Left.Data (1 .. Max_Length);
  216.  
  217.                   else
  218.                      Result.Data (1 .. Llen) := Left.Data;
  219.                      Result.Data (Llen + 1 .. Max_Length) :=
  220.                        Right (1 .. Max_Length - Llen);
  221.                   end if;
  222.  
  223.                when Strings.Left =>
  224.                   if Rlen >= Max_Length then
  225.                      Result.Data (1 .. Max_Length) :=
  226.                        Right (Rlen - (Max_Length - 1) .. Rlen);
  227.  
  228.                   else
  229.                      Result.Data (1 .. Max_Length - Rlen) :=
  230.                        Left.Data (Llen - (Max_Length - Rlen + 1) .. Lle